Celestin Apprentice 4/Apprentice-Release4.iso/Languages/Open Prolog 1.0.3d23/External Predicates…/Sources/draw.p

Text File | 1995-11-10 | 21.7 KB | 656 lines | [TEXT/MPS ]

{$D+} { MacsBug symbols on }
{$R-} { No range checking }

UNIT draw;

  INTERFACE

    USES quickdraw, toolUtils, scrap, standardFile,prlxdefinitions,
         prlxLibraries;

    PROCEDURE entrypoint(plist: prlxptr);

  IMPLEMENTATION

    CONST
      openCommand = 1;
      closeCommand = 2;
      lineCommand = 3;
      rectCommand = 4;
      textCommand = 5;
      penSizeCommand = 6;
      penModeCommand = 7;
      penPatCommand = 8;
      foreColorCommand = 9;
      backColorCommand = 10;
      eraseCommand = 11;
      ovalCommand = 12;

    TYPE
 (*     rectPtr = ^rect; *)
      pickKind = (pickLine, pickRect,pickOval, pickText, pickPenSize, pickPenMode,
                  pickPenPat, pickForeColor, pickBackColor);
      pickHandle = ^pickPtr;
      pickPtr = ^pickRec;
      pickRec = RECORD
                  sized: boolean;
                  boundsRect: rect;
                  next: pickHandle;
                  CASE kind: pickKind OF
                    pickLine:
                      (lineStart, lineEnd: point);
                    pickRect,pickOval:
                      (r: rect);
                    pickText:
                      (s: stringHandle;
                       p: point);
                    pickPenSize:
                      (width, height: integer);
                    pickPenMode:
                      (m: integer);
                    pickPenPat:
                      (patternIndex: integer);
                    pickForeColor:
                      (colorIndex: integer);
                    pickBackColor:
                      (colorIndxex: integer);
                END;
      drawingRecord = RECORD
                        pen: penState;
                        foregroundColor, backgroundColor: longint;
                      END;

      graphicWindowPtr = ^graphicWindowRec;
      graphicWindowRec = RECORD
                           window: windowRecord;
                           occupied: boolean;
                           pick, lastPick: pickHandle;
                           picturePresent: boolean; {i.e. at least one visible
                                                     command}
                           boundsRect: rect;
                           defaultState, currentState: drawingRecord;
                           oldClip: rgnHandle;
                         END;

    PROCEDURE main(plist: prlxptr);
      FORWARD;

    PROCEDURE entrypoint(plist: prlxptr);

      BEGIN
        main(plist);
      END;

    FUNCTION integerMin(a, b: longint): longint;

      BEGIN
        IF a > b THEN
          integerMin := b
        ELSE
          integerMin := a;
      END;

    FUNCTION integerMax(a, b: longint): longint;

      BEGIN
        IF a < b THEN
          integerMax := b
        ELSE
          integerMax := a;
      END;

    PROCEDURE getDrawingState(theWindow: graphicWindowPtr;
                              VAR state: drawingRecord);

      BEGIN
        WITH state DO
          BEGIN
          getPenState(pen);
          foreGroundColor := windowPtr(theWindow)^.fgColor;
          backGroundColor := windowPtr(theWindow)^.bkColor;
          END;
      END;

    PROCEDURE setDrawingState(VAR state: drawingRecord);

      BEGIN
        WITH state DO
          BEGIN
          setPenState(pen);
          foreColor(foreGroundColor);
          backColor(backGroundColor);
          END;
      END;

    FUNCTION qdColor(colorIndex: longint): longint;

      BEGIN
        CASE colorIndex OF
          0: qdColor := blackColor;
          1: qdColor := yellowColor;
          2: qdColor := magentaColor;
          3: qdColor := redColor;
          4: qdColor := cyanColor;
          5: qdColor := greenColor;
          6: qdColor := blueColor;
          7: qdColor := whiteColor;
        END;
      END;

    FUNCTION drawHandler(theWindow: graphicWindowPtr;
                         parameter: longint;
                         message: integer): longint;

      VAR
        s: str255;
        oldPort: grafPtr;
        scrapPic: picHandle;
        rptr: rectPtr;
        theRect1,theRect2: rect;
        ignoreBoolean: boolean;
        ignoreLongint: longint;

      PROCEDURE drawpick(theWindow: graphicWindowPtr);

        VAR
          myPick: pickHandle;
          pat: pattern;
          theRect: rect;

        BEGIN
          setDrawingState(theWindow^.defaultState);
          getClip(theWindow^.oldClip);
          theRect := windowPtr(theWindow)^.portRect;
          theRect.bottom := theRect.bottom - 15;
          theRect.right := theRect.right - 15;
          clipRect(theRect);
          myPick := theWindow^.pick;
          WHILE myPick <> NIL DO
            BEGIN
            hlock(handle(myPick));
            WITH myPick^^ DO
              BEGIN
              CASE kind OF
                pickLine:
                  BEGIN
                  moveTo(lineStart.h, lineStart.v);
                  lineTo(lineEnd.h, lineEnd.v);
                  END;
                pickRect: frameRect(r);
                pickOval: frameOval(r);
                pickText:
                  BEGIN
                  moveTo(p.h, p.v);
                  hLock(handle(s));
                  drawString(s^^);
                  hUnLock(handle(s));
                  END;
                pickPenSize: penSize(width, height);
                pickPenMode: penMode(m);
                pickPenPat:
                  BEGIN
                  getIndPattern(pat, sysPatListID, patternIndex);
                  penPat(pat);
                  END;
                pickForeColor: foreColor(qdColor(colorIndex));
                pickBackColor: backColor(qdColor(colorIndex));
              END;
              hUnlock(handle(myPick));
              myPick := myPick^^.next;
              END;
            END;
          setClip(theWindow^.oldClip);
          setDrawingState(theWindow^.defaultState);
        END;

      BEGIN
        drawHandler := messageOK;
        CASE message OF
          eventActivate, eventResume:
            BEGIN
            getport(oldport);
            setPort(windowPtr(theWindow));
            drawGrowIcon(windowPtr(theWindow));
            setport(oldPort);
            END;
          eventGetGrowLimit:
            IF theWindow^.picturePresent THEN
              BEGIN
              rptr := rectPtr(parameter);
              WITH rptr^ DO
                BEGIN
                topLeft := theWindow^.boundsRect.topLeft;
                botRight := theWindow^.boundsRect.botRight;
                bottom := bottom + 16;
                right := right + 16;
                END;
              END;
          eventSetWindowSize:
            BEGIN
            getport(oldport);
            setPort(windowPtr(theWindow));
            theRect1 := windowPtr(theWindow)^.portRect;
            WITH theRect1 DO
              BEGIN
          bottom:=bottom-16;
               right := right - 16;
              END;

            sizeWindow(windowPtr(theWindow), loword(parameter),
                       hiword(parameter), false);

            theRect2 := windowPtr(theWindow)^.portRect;
            invalRect(theRect2);
            WITH theRect2 DO
              BEGIN
              bottom := bottom -16;
              right := right -16;
           END;
           ignoreBoolean:=sectRect(theRect1, theRect2, theRect1);
            validRect(theRect1);
                setport(oldPort);
            END;

          eventUpdate:
            BEGIN
            getport(oldport);
            setPort(windowPtr(theWindow));
            beginUpdate(windowPtr(theWindow));
        eraseRect(windowPtr(theWindow)^.portRect);
            drawGrowIcon(windowPtr(theWindow));
            drawPick(theWindow);
            UpdtControl(windowPtr(theWindow), windowPeek(theWindow)^.updateRgn);
            endUpdate(windowPtr(theWindow));
            setport(oldPort);
            END;

          eventQuit: drawHandler := messageQuit;
          eventMenuSelect:
            BEGIN
            getport(oldport);
            setPort(windowPtr(theWindow));
            IF (hiword(parameter) = editmenu) AND (loword(parameter) =
               copyitem) THEN
              BEGIN
              IF theWindow^.picturePresent THEN
                clipRect(theWindow^.boundsRect)
              ELSE
                clipRect(windowPtr(theWindow)^.portRect);
              scrapPic := openPicture(windowPtr(theWindow)^.portRect);
              drawPick(theWindow);
              closePicture;
              hlock(handle(scrapPic));
              IF zeroScrap = noErr THEN
                IF putScrap(getHandleSize(handle(scrapPic)), 'PICT',
                            handle(scrapPic)^) = noErr THEN
                  IF unloadScrap = noErr THEN drawHandler := messageOK;
              hUnLock(handle(scrapPic));
              END
            ELSE IF (hiword(parameter) = editmenu) AND (loword(parameter) =
                    cutitem) THEN
              BEGIN
              IF theWindow^.picturePresent THEN
                frameRect(theWindow^.boundsRect);
              END
            ELSE
              drawHandler := messageNoReply;

            setport(oldPort);
            hiliteMenu(0);
            END;
          OTHERWISE drawHandler := messageNoReply;
        END;

      END;

    PROCEDURE main;

      VAR
        s: str255;
        i: integer;
        l, m: longint;
        newPick: pickHandle;
        pat: pattern;

      PROCEDURE draw;

        VAR
          theRect: rect;
          theWindow: graphicWindowPtr;
          result: longint;
          p: procPtr;
          st: str255;
          u, x, y, z: longint;
          oldPort: grafptr;
          aControl: controlHandle;
          myFontInfo: fontInfo;

        PROCEDURE addPick(p: pickHandle;
                          theWindow: graphicWindowPtr);

          VAR
            q: pickHandle;

          BEGIN
            IF theWindow^.pick = NIL THEN
              theWindow^.pick := p
            ELSE
              theWindow^.lastPick^^.next := p;

            theWindow^.lastPick := p;
            p^^.next := NIL;
            IF theWindow^.picturePresent THEN
              BEGIN
              IF p^^.sized THEN
                unionRect(theWindow^.boundsRect, p^^.boundsRect,
                          theWindow^.boundsRect);
              END
            ELSE
              BEGIN
              theWindow^.boundsRect := p^^.boundsRect;
              theWindow^.picturePresent := p^^.sized;
              END;
          END;

        BEGIN
          plist^.determinate := true;
          newPick := NIL;
          getPort(oldPort);
          theWindow := graphicWindowPtr(plist^.data[2]);
          IF theWindow^.occupied THEN
            BEGIN
            setPort(windowPtr(theWindow));
            setDrawingState(theWindow^.currentState);
            getClip(theWindow^.oldClip);
            theRect := windowPtr(theWindow)^.portRect;
            theRect.bottom := theRect.bottom - 15;
            theRect.right := theRect.right - 15;
            clipRect(theRect);

            END;

          CASE value(1, plist) OF
            openCommand:
              IF NOT graphicWindowPtr(plist^.data[2])^.occupied THEN
                BEGIN { new window }
                x := value(subterm(1, 2, plist), plist);
                y := value(subterm(2, 2, plist), plist);
                u := value(subterm(3, 2, plist), plist);
                z := value(subterm(4, 2, plist), plist);
                st := text(2, plist);
                setRect(theRect, y, x, z, u);
                p := @drawHandler;
                theWindow := graphicWindowPtr(newWindow(ptr(plist^.data[2]),
                                                        theRect, st, false,
                                                        documentProc,
                                                        pointer( - 1), false,
                                                        longint(p)));
                setPort(windowPtr(theWindow));
                graphicWindowPtr(theWindow)^.occupied := true;
                graphicWindowPtr(theWindow)^.pick := NIL;
                graphicWindowPtr(theWindow)^.picturePresent := false;
                setRect(theRect, z - 16, x, z - 1, u - 16);
                aControl := newControl(windowPtr(theWindow), theRect, '', true,
                                       0, 0, 10, scrollBarProc, 0);
                setRect(theRect, y, u - 16, z - 16, u);
                aControl := newControl(windowPtr(theWindow), theRect, '', true,
                                       0, 0, 10, scrollBarProc, 0);
                getDrawingState(theWindow, theWindow^.defaultState);
                theWindow^.oldClip := newRgn;
                getClip(theWindow^.oldClip);
                showWindow(windowPtr(theWindow));
                END;
            eraseCommand:
              WITH theWindow^ DO
                IF occupied THEN
                  BEGIN { only if occupied }
                  WHILE pick <> NIL DO
                    BEGIN
                    newPick := pick^^.next;
                    disposHandle(handle(pick));
                    pick := newPick;
                    END;
                  pick := NIL;
                  picturePresent := false;
                  setDrawingState(theWindow^.defaultState);
                  theRect := windowPtr(theWindow)^.portRect;
                  eraseRect(theRect);
                  invalRect(theRect);
                  END;
            closeCommand:
              WITH theWindow^ DO
                IF occupied THEN
                  BEGIN { only if occupied }

                  WHILE pick <> NIL DO
                    BEGIN
                    newPick := pick^^.next;
                    disposHandle(handle(pick));
                    pick := newPick;
                    END;
                  occupied := false;
                  pick := NIL;
                  picturePresent := false;
                  disposeRgn(theWindow^.oldClip);
                  closeWindow(windowPtr(plist^.data[2]));
                  END;
            lineCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                y := value(subterm(2, 2, plist), plist);
                u := value(subterm(3, 2, plist), plist);
                z := value(subterm(4, 2, plist), plist);
                MoveTo(x, y);
                Lineto(u, z);
                WITH newPick^^ DO
                  BEGIN
                  sized := true;
                  boundsRect.top := integerMin(y, z);
                  boundsRect.left := integerMin(x, u);
                  boundsRect.bottom := integerMax(y,
                                       z) + theWindow^.currentState.pen.pnSize.
                                       v;
                  boundsRect.right := integerMax(x,
                                      u) + theWindow^.currentState.pen.pnSize.h
                                      ;
                  kind := pickLine;
                  lineStart.h := x;
                  lineStart.v := y;
                  lineEnd.h := u;
                  lineEnd.v := z;
                  END;
                addPick(newPick, theWindow);
                END;
            textCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                y := value(subterm(2, 2, plist), plist);
                st := text(subterm(3, 2, plist), plist);
                MoveTo(x, y);
                DrawString(st);
                getFontInfo(myFontInfo);
                WITH newPick^^ DO
                  BEGIN
                  sized := true;
                  boundsRect.top := y - myFontINfo.ascent;
                  boundsRect.left := x;
                  boundsRect.bottom := y + myFontINfo.descent;
                  boundsRect.right := x + stringWidth(st);
                  kind := pickText;
                  p.h := x;
                  p.v := y;
                  s := newString(st);
                  END;
                addPick(newPick, theWindow);
                END;
           ovalCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                y := value(subterm(2, 2, plist), plist);
                u := value(subterm(3, 2, plist), plist);
                z := value(subterm(4, 2, plist), plist);
                setRect(theRect, x, y, u, z);
                frameOval(theRect);
                WITH newPick^^ DO
                  BEGIN
                  sized := true;
                  boundsRect := theRect;
                  kind := pickOval;
                  r := theRect;
                  END;
                addPick(newPick, theWindow);
                END;
            rectCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                y := value(subterm(2, 2, plist), plist);
                u := value(subterm(3, 2, plist), plist);
                z := value(subterm(4, 2, plist), plist);
                setRect(theRect, x, y, u, z);
                frameRect(theRect);
                WITH newPick^^ DO
                  BEGIN
                  sized := true;
                  boundsRect := theRect;
                  kind := pickRect;
                  r := theRect;
                  END;
                addPick(newPick, theWindow);
                END;
            penSizeCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                y := value(subterm(2, 2, plist), plist);
                penSize(x, y);
                WITH newPick^^ DO
                  BEGIN
                  sized := false;
                  kind := pickPenSize;
                  width := x;
                  height := y;
                  END;
                addPick(newPick, theWindow);
                END;
            penModeCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                penMode(x);
                WITH newPick^^ DO
                  BEGIN
                  sized := false;
                  kind := pickPenMode;
                  m := x;
                  END;
                addPick(newPick, theWindow);
                END;
            penPatCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                getIndPattern(pat, sysPatListID, x);
                penPat(pat);
                WITH newPick^^ DO
                  BEGIN
                  sized := false;
                  kind := pickPenPat;
                  patternIndex := x;
                  END;
                addPick(newPick, theWindow);
                END;
            foreColorCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                foreColor(qdColor(x));
                WITH newPick^^ DO
                  BEGIN
                  sized := false;
                  kind := pickForeColor;
                  colorIndex := x;
                  END;
                addPick(newPick, theWindow);
                END;
            backColorCommand:
              IF theWindow^.occupied THEN
                BEGIN
                newPick := pickHandle(newHandle(sizeOf(pickRec)));
                x := value(subterm(1, 2, plist), plist);
                backColor(qdColor(x));
                WITH newPick^^ DO
                  BEGIN
                  sized := false;
                  kind := pickBackColor;
                  colorIndex := x;
                  END;
                addPick(newPick, theWindow);
                END;

          END; { case }
          IF theWindow^.occupied THEN
            BEGIN
            getDrawingState(theWindow, theWindow^.currentState);
            setDrawingState(theWindow^.defaultState);
            setClip(theWindow^.oldClip);
            END;
          IF oldPort <> grafPtr(theWindow) THEN setPort(oldPort);
        END; { procedure }

      BEGIN
        WITH plist^ DO
          BEGIN
          CASE request OF
            getPRLXInfo:
                        begin
                        data[1] := 1; {number of predicates defined}
                        data[2]:=eventsVersion;
                        end;
            initialisepredicate:
              CASE id OF
                1: {draw/3}
                  BEGIN
                  s := 'draw'; {name}
                  data[1] := 3; {arity - command,argument,result}
                  data[2] := longint(newPtr(sizeOf(graphicWindowRec))); {permanent
                    data}
                  graphicWindowPtr(data[2])^.occupied := false;
                  END;
                OTHERWISE
                  errorstr('predicate index out of range at initialise', plist);
              END;
            callpredicate:
              BEGIN
              successful := true;
              CASE id OF
                1: draw;
                OTHERWISE
                  errorstr('predicate index out of range at call', plist);
              END;
              END;
            closepredicate:
              BEGIN
              CASE id OF
                1: {draw} ;
                OTHERWISE
                  errorstr('predicate index out of range at close', plist);
              END;
              END;
            OTHERWISE errorstr('unknown call to external procedures', plist);
          END;
          END;
      END;
END.